perm filename CHECK.INS[1,JRA] blob sn#019570 filedate 1973-01-11 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP VARSIN 
00400	 (LAMBDA(C)
00500	  (PROG (C1 VARS)
00600	   A    (SETQ C (CDR C))
00700		(COND ((NULL C) (RETURN VARS)))
00800		(SETQ C1 (COND ((NEG (CAR C)) (CDDAR C)) (T (CDAR C))))
00900		(SETQ VARS (APPEND (VARSIN1 C1) VARS))
01000		(GO A))) 
01100	EXPR)
01200	
01300	(DEFPROP VARSIN1 
01400	 (LAMBDA(C1)
01500	  (PROG (VARS)
01600	   A    (COND ((NULL C1) (RETURN VARS))
01700		      ((VAR (CAR C1)) (SETQ VARS (CONS (CAR C1) VARS)))
01800		      ((CONST (CAR C1)) NIL)
01900		      (T (SETQ VARS (APPEND (VARSIN1 (CDAR C1)) VARS))))
02000		(SETQ C1 (CDR C1))
02100		(GO A))) 
02200	EXPR)
02300	
02400	(DEFPROP CHECKINST 
02500	 (LAMBDA(Z C D)
02600	  (PROG (Z1 Z2)
02650	(COND((NULL Z)(RETURN T)))
02700	(SETQ Z2(APPEND(VARSIN C)(VARSIN D)))
02800	(COND((NULL Z2)(RETURN T)))
03000	A(SETQ Z1(CONS(CAAR Z) Z1))
03050	(SETQ Z(CDR Z))(COND(Z(GO A)))
03075	B(COND((NULL Z2)(RETURN T))
03087	    ((NOT(MEMQ(CAR Z2)Z1))(RETURN NIL)))
03093	(SETQ Z2(CDR Z2))(GO B)
03800	))
03900	EXPR)
04000	
04100	(DEFPROP RESOLVE1 
04200	 (LAMBDA(C D)
04300	  (PROG (CB DB DB1 YC YD YD1 Z X Y RES)
04400		(COND ((AND COND (EVAL COND)) (ERR (CDR LCL))))
04500		(SETQ YC (CDR C))
04600		(SETQ CB (POSBIT C))
04700		(SETQ YD1 (NEGL D))
04800		(SETQ DB1 (NEGBIT D))
04900		(SETQ DB DB1)
05000		(SETQ YD YD1)
05100	   RES1 (SETQ X (CAR YC))
05200		(COND ((NEG X) (RETURN RES)))
05300		(SETQ Y (CAR YD))
05400		(COND ((ORDERP (CAR X) (CADR Y)) (GO RES3)) ((NOT (EQ (CAR X) (CADR Y))) (GO RES4)))
05500		(SETQ YD1 YD)
05600		(SETQ DB1 DB)
05700		(GO RES2A)
05800	   RES2 (SETQ Y (CAR YD))
05900		(COND ((NOT (EQ (CAR X) (CADR Y))) (GO RES3A)))
06000	   RES2A
06100		(COND ((NOT (UNIFAB (CAR CB) (CAR DB))) (GO RES2B)))
06200		(SETQ Z (UNIFY (CDR X) (CDDR Y)))
06300		(COND ((NULL Z) (GO RES2B)))
06350	(COND((NOT(CHECKINST (CDR Z) C D))(GO RES2B)))
06400		(SETQ PARRES NIL)
06500		(SETQ Z (UNION (CDR Z) C D X Y))
06600		(COND ((NULL Z) (GO RES2B)) ((NULL (CAR Z)) (RETURN Z)))
06700		(SETQ RES (CONS (SET2 (CAR (COND (DLIST (DEMOD Z DLIST)) (T Z))) TBL) RES))
06800	   RES2B
06900		(SETQ YD (CDR YD))
07000		(COND (YD (SETQ DB (CDR DB)) (GO RES2)))
07100	   RES3A
07200		(SETQ DB DB1)
07300		(SETQ YD YD1)
07400	   RES3 (SETQ YC (CDR YC))
07500		(COND (YC (SETQ CB (CDR CB)) (GO RES1)))
07600		(RETURN RES)
07700	   RES4 (SETQ YD (CDR YD))
07800		(COND (YD (SETQ DB (CDR DB)) (GO RES1)))
07900		(GO RES3A))) 
08000	EXPR)